unit fIsoSurfaces;

interface

uses
  Winapi.OpenGL,
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.ExtCtrls,
  Vcl.StdCtrls,
  Vcl.ComCtrls,
  Vcl.Buttons,
  Vcl.Forms,
  Vcl.Dialogs,

  GLS.SceneViewer,

  GLS.BaseClasses,
  GLS.Scene,
  GLS.Objects,
  GLS.Coordinates,
  GLS.Color,
  GLS.VectorGeometry,
  GLS.Mesh,
  GLS.VectorFileObjects,
  GLS.State,
  GLS.GeomObjects,
  GLS.Extrusion,
  GLS.VectorTypesExt,
  GLS.IsosurFace,
  GLS.SimpleNavigation,
  GLS.Material;

type
  TForm1 = class(TForm)
    Scene: TGLScene;
    Viewer: TGLSceneViewer;
    Camera: TGLCamera;
    dcWorld: TGLDummyCube;
    Light: TGLLightSource;
    meshSurf: TGLMesh;
    SimpleNavigation: TGLSimpleNavigation;
    freeSurf: TGLFreeForm;
    PanelLeft: TPanel;
    rgSurface: TRadioGroup;
    Label2: TLabel;
    edIsoValue: TEdit;
    bbRunMC: TBitBtn;
    cbFillLines: TCheckBox;
    rgScalarField: TRadioGroup;
    rgFaceCulling: TRadioGroup;
    tbIsoValue: TTrackBar;
    procedure FormDestroy(Sender: TObject);
    procedure cbFillLinesClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bbRunMCClick(Sender: TObject);
    procedure rgSurfaceClick(Sender: TObject);
    procedure rgScalarFieldClick(Sender: TObject);
    procedure rgFaceCullingClick(Sender: TObject);
    procedure tbIsoValueChange(Sender: TObject);
  private
    meshObj: TGLMeshObject;
    MC: TGLMarchingCube;
  end;

(*
// Sphere surface
function SFSphere(X, Y, Z: Extended): TScalarValue;
// Minkowski space (http://mathworld.wolfram.com)
function SFMinkowski(X, Y, Z: Extended): TScalarValue;
// Klein Bottle (http://mathworld.wolfram.com)
function SFKleinBottle(X, Y, Z: Extended): TScalarValue;
// Chmutov-surface-1 (http://mathworld.wolfram.com)
function SFChmutov1(X, Y, Z: Extended): TScalarValue;
// Chmutov-surface-2 (http://mathworld.wolfram.com)
function SFChmutov2(X, Y, Z: Extended): TScalarValue;
// Toroidal surface (phantasy!)
function SFToroidal(X, Y, Z: Extended): TScalarValue;
// Double torus Surface (phantasy!)
function SFDoubleTorus(X, Y, Z: Extended): TScalarValue;
*)
const
  DemoScalarField: array [0 .. 6] of
  record
    // xMin, xMax, yMin, yMax, zMin, zMax:Single; // default -0.5..0.5
    ScalarField: TScalarField;
    IsoValue: TScalarValue
  end = ((ScalarField: SFSphere; IsoValue: 0.3),
         (ScalarField: SFMinkowski; IsoValue: 0.0),
         (ScalarField: SFKleinBottle; IsoValue: 0.0),
         (ScalarField: SFChmutov1; IsoValue: 3.0),
         (ScalarField: SFChmutov2; IsoValue: 3.0),
         (ScalarField: SFToroidal; IsoValue: 3.0),
         (ScalarField: SFDoubleTorus; IsoValue: 0.015));

var
  Form1: TForm1;

//===========================================
implementation
//===========================================

{$R *.dfm}

(*
// Test surface functions
function SFSphere(X, Y, Z: Extended): TScalarValue;
begin
  Result := sqr(X) + sqr(Y) + sqr(Z)
end;

function SFToroidal(X, Y, Z: Extended): TScalarValue;
const
  FScale = 7;
  a = 2.5;
begin
  X := FScale * X;
  Y := FScale * Y;
  Z := FScale * Z;
  Result := (sqr(sqrt(sqr(X) + sqr(Y)) - a) + sqr(Z)) *
    (sqr(sqrt(sqr(Y) + sqr(Z)) - a) + sqr(X)) *
    (sqr(sqrt(sqr(Z) + sqr(X)) - a) + sqr(Y));
end;

function SFDoubleTorus(X, Y, Z: Extended): TScalarValue;
const
  FScale = 2.25;
begin
  X := FScale * X;
  Y := FScale * Y;
  Z := FScale * Z;
  Result := PowerInteger(X, 8) + PowerInteger(X, 4) - 2 * PowerInteger(X, 6) - 2
    * sqr(X) * sqr(Y) + 2 * PowerInteger(X, 4) * sqr(Y) +
    PowerInteger(Y, 4) + sqr(Z)
end;

function SFChmutov1(X, Y, Z: Extended): TScalarValue;
const
  FScale = 2.5;
begin
  X := FScale * X;
  Y := FScale * Y;
  Z := FScale * Z;
  Result := 8 * (sqr(X) + sqr(Y) + sqr(Z)) - 8 *
    (PowerInteger(X, 4) + PowerInteger(Y, 4) + PowerInteger(Z, 4));
end;

function SFChmutov2(X, Y, Z: Extended): TScalarValue;
const
  FScale = 2.5;
begin
  X := FScale * X;
  Y := FScale * Y;
  Z := FScale * Z;
  Result := 2 * (sqr(X) * sqr(3 - 4 * sqr(X)) + sqr(Y) * sqr(3 - 4 * sqr(Y)) +
    sqr(Z) * sqr(3 - 4 * sqr(Z)));
end;

function SFKleinBottle(X, Y, Z: Extended): TScalarValue;
const
  FScale = 7.5;
begin
  X := FScale * X;
  Y := FScale * Y;
  Z := FScale * Z;
  Result := (sqr(X) + sqr(Y) + sqr(Z) + 2 * Y - 1) *
    (sqr(sqr(X) + sqr(Y) + sqr(Z) - 2 * Y - 1) - 8 * sqr(Z)) + 16 * X * Z *
    (sqr(X) + sqr(Y) + sqr(Z) - 2 * Y - 1);
end;

function SFMinkowski(X, Y, Z: Extended): TScalarValue;
const
  FScale = 7;
begin
  X := FScale * X;
  Y := FScale * Y;
  Z := FScale * Z;
  Result := (sqr(X) - sqr(Y) - sqr(Z) - 2) * (sqr(X) - sqr(Y) - sqr(Z) + 2) *
    (sqr(X) - sqr(Y) - sqr(Z) - 4) * (sqr(X) - sqr(Y) - sqr(Z) + 4) *
    (sqr(X) - sqr(Y) - sqr(Z));
end;

*)

//----------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
  MC := TGLMarchingCube.Create(100, 100, 100);

  meshObj := TGLMeshObject.CreateOwned(freeSurf.MeshObjects);
  meshObj.Mode := momFaceGroups;

  Light.Position.SetPoint(100, 200, 300);
  Light.Ambient.SetColor(0.6, 0.6, 0.0, 0.1);
  Light.Diffuse.SetColor(0.2, 0.4, 1.0, 0.1);
  Light.Specular.SetColor(1.0, 1.0, 1.0, 0.1);

  if rgSurface.ItemIndex = 0 then // using GLFreeForm
    meshSurf.Visible := False
  else // using GLMesh
    freeSurf.Visible := False;

  cbFillLinesClick(Self);
  bbRunMCClick(Self)
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MC.Free;
  meshObj.Free;
end;

procedure TForm1.cbFillLinesClick(Sender: TObject);
begin
  if rgSurface.ItemIndex = 0 then // using TGLFreeForm
  begin
    if cbFillLines.Checked then
      freeSurf.Material.PolygonMode := pmFill
    else
      freeSurf.Material.PolygonMode := pmLines
  end
  else // using TGLMesh
  begin
    if cbFillLines.Checked then
      meshSurf.Material.PolygonMode := pmFill
    else
      meshSurf.Material.PolygonMode := pmLines
  end;
end;

procedure TForm1.rgScalarFieldClick(Sender: TObject);
begin
  edIsoValue.Text := FloatToStr(DemoScalarField[rgScalarField.ItemIndex].IsoValue);
  bbRunMCClick(Self)
end;

procedure TForm1.rgFaceCullingClick(Sender: TObject);
begin
  if rgSurface.ItemIndex = 0 then
    freeSurf.Material.FaceCulling := TGLFaceCulling(rgFaceCulling.ItemIndex)
  else
    meshSurf.Material.FaceCulling := TGLFaceCulling(rgFaceCulling.ItemIndex);
end;

procedure TForm1.bbRunMCClick(Sender: TObject);
var
  IsoValue: TScalarValue;
begin
  // try to accept user value, but if uncorrect assign a correct demo value
  IsoValue := StrToFloatDef(edIsoValue.Text, DemoScalarField[rgScalarField.ItemIndex].IsoValue);
  edIsoValue.Text := FormatFloat('0.0000', IsoValue);

  MC.FillVoxelData(IsoValue, DemoScalarField[rgScalarField.ItemIndex].ScalarField);
  MC.Run;

  if rgSurface.ItemIndex = 0 then // using GLFreeForm
  begin
    meshObj.Free;
    meshObj := TGLMeshObject.CreateOwned(freeSurf.MeshObjects);
    meshObj.Mode := momFaceGroups;
    MC.CalcMeshObject(meshObj, 0.6);
  end
  else // using GLMesh
    MC.CalcVertices(meshSurf.Vertices);
  Viewer.Invalidate;
end;

procedure TForm1.rgSurfaceClick(Sender: TObject);
begin
  if rgSurface.ItemIndex = 0 then // using GLFreeForm
  begin
    meshSurf.Visible := False;
    freeSurf.Visible := True;
  end
  else  // using GLMesh
  begin
    freeSurf.Visible := False;
    meshSurf.Visible := True;
  end;
  cbFillLinesClick(Self);
  rgScalarFieldClick(Self);
end;

procedure TForm1.tbIsoValueChange(Sender: TObject);
begin
  edIsoValue.Text := FloatToStr(tbIsoValue.Position/10);
end;

end.
